Garbo/Garbo.cdr/mac/hypercrd/xcmd/dxcmds34.sit/Dartmouth XCMD's 3.4.3/card_13535.txt

Text File | 1990-04-17 | 15KB | 444 lines

-- card: 13535 from stack: in.3
-- bmap block id: 0
-- flags: 4000
-- background id: 3241
-- name: GetResources
----- HyperTalk script -----
on Install
  get ChooseTargetStack()
  InstallResource XCMD,GetResources,it
end Install


-- part 1 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=299 top=300 right=322 bottom=438
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Show Pascal Source
----- HyperTalk script -----
on mouseUp
  set the visible of card field 1 to not the visible of card field 1
  if the visible of card field 1 is true then
    set the name of me to "Hide Pascal Source"
  else set the name of me to "Show Pascal Source"
end mouseUp



-- part 2 (field)
-- low flags: 81
-- high flags: 2007
-- rect: left=12 top=26 right=298 bottom=491
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 22
-- text size: 10
-- style flags: 0
-- line height: 13
-- part name: Source


-- part contents for background part 16
----- text -----
GETRESOURCES XCMD version 1.6
Kevin Calhoun

The GetResources XCMD is intended for XCMD and XFCN developers who need a fast way to copy resources into a stack for testing.  For XCMD and XFCN users who want to copy resources from one stack to another, the ResCopy XCMD by Steve Maller is more appropriate than GetResources.

GetResources copies resources to the current stack from a file designated by full pathname.  The set of resources to be copied from that file can be defined in three different ways:

  1)  all resources of type XCMD or XFCN in the file,
  2)  all the resources found in the file other than resources of type CODE, FREF, or
        BNDL, which have been determined to be harmful to the operating system when
        copied indiscriminately, and
  3)  all resources in the file of the types you specify.

GetResources does not rename or renumber resources before adding them to the current stack;  instead, it will remove any resource already contained in the current stack that has the same name and type (or the same ID and type) as a resource that it copies to the stack.  If the current stack has no resource fork, GetResources will add a resource fork to the stack before copying resources to it.

As with other resource copiers, if you use GetResources to copy a resource into the Home stack, you may have to quit and relaunch HyperCard in order to use it.

WHY DID I WRITE THIS WHEN PERFECTLY GOOD RESOURCE COPIERS EXIST ALREADY?...

There was no way to copy resources blindly from one file to another.  I wanted a way to say, "Get me whatever's over there and put it here, and don't keep asking me if it's OK."

INVOKING GETRESOURCES

GetResources "sourceFile","listOfTypes"

GetResources takes two parameters, the second of which is optional.

Parameter 1:  the file name (full pathname) of the file to copy from.
Parameter 2:  the types of resources to copy.  If the second parameter is not present, GetResources copies only the XFCN's and XCMD's found in the specified file.  If you pass the string "ALL" for this parameter, GetResources will copy all the resources found in the file (excepting CODE, FREF, and BNDL resources).  If this parameter is anything other than "ALL", it is interpreted as a list of resource types to copy.

Examples:

GetResources "Dr.HD:HyperCard ƒ:HyperCard Stacks:Developer Stack 1.3","ALL"
   --copies all resources from Developer Stack 1.3 to the current stack (excepting the
   --types noted above)

GetResources "My HD:System Folder:System","ICON,PICT"
   --copies all ICON and PICT resources found in the System File into the current stack

GetResources "Old Peculier:Hyper ƒ:HyperCard Stacks:Home"
   --copies all XCMD and XFCN resources found in the home stack into the current stack

In case anybody asks, it's true that I wrote DeleteResFork in order to recover from bad things that happened while I was developing GetResources.

Revision history:
15 March 1989 -- first release.
11 June 1989 -- Minor change for compatibility with SuperCard.  GetResources checks whether HyperCard is running after copying the resources and goes home and back only under HyperCard.
22 July 1989 -- No longer leaves a NIL master pointer behind when replacing a resource.

-- part contents for card part 2
----- text -----
UNIT AutoResUnit;

{ GetResources XCMD © 1988-1989 by the Trustees of Dartmouth College }
{ Written by Kevin Calhoun }

{ This source compatible with MPW Pascal 3.0 }

(*
Pascal GetResources.p
Link -m ENTRYPOINT Γêé
     -o "YourFile" Γêé
     -rt XCMD=7449 Γêé
     -sn Main=GetResources Γêé
     GetResources.p.o Γêé
    "{Libraries}"interface.o Γêé
    "{PLibraries}"Paslib.o Γêé
    "{Libraries}"HyperXLib.o
*)

{$R-}

INTERFACE
  USES
    Types,
    Memory,
    Resources,
    Files,
    Errors,
    SysEqu,
    ToolUtils,
    HyperXCmd;

  PROCEDURE EntryPoint (paramPtr : XCmdPtr);

IMPLEMENTATION

  TYPE ToGrab = (extensions, all, userType);

  PROCEDURE GetResources(paramPtr : XCmdPtr); FORWARD;

  PROCEDURE EntryPoint (paramPtr : XCmdPtr);
  BEGIN
    GetResources(paramPtr);
  END;

  FUNCTION MyOpenResFile(fileName: Str255; VAR refNum: INTEGER;
                          VAR wasOpen: BOOLEAN): OSErr;
    TYPE
      HandlePtr = ^Handle;
    VAR
      oldTopMapHndl: Handle;
  BEGIN
    MyOpenResFile := noErr;
    oldTopMapHndl := HandlePtr(TopMapHndl)^;  { remember current TopMapHndl }
    refNum := OpenResFile(fileName);          { open resource file }
    IF (refNum = -1) THEN { error opening file }
      BEGIN
      MyOpenResFile := ResError;
      EXIT(MyOpenResFile);
      END
    ELSE
      IF (oldTopMapHndl = HandlePtr(TopMapHndl)^) THEN wasOpen := TRUE
        { no change -- it was open }
      ELSE wasOpen := FALSE;
        { res file wasn't open before }
  END;

  FUNCTION GetFullPathnameOfThisStack (paramPtr : XCMDPtr; var str: Str255) : OSErr;
    VAR
      theResult : Handle;
      theLength : Longint;
      err: OSErr;
  BEGIN
    err := noErr;
    str := 'word 2 of the long name of this stack';
    theResult := EvalExpr(paramPtr, str);
    err := paramPtr^.result;
    IF (theResult <> NIL) and (err = noErr) THEN
      BEGIN
      theLength := StringLength(paramPtr, theResult^);
      ZeroToPas(paramPtr, theResult^, str);
      DisposHandle(theResult);
      DELETE(str,theLength,1);
      DELETE(str,1,1);
      END
    ELSE str := '';
    GetFullPathnameOfThisStack := err;
  END;

  FUNCTION OpenAndMaybeCreateResFile (theFile : Str255; VAR fRefNum: INTEGER) : OSErr;
    VAR
      err : OSErr;
  BEGIN
    err := noErr;
    fRefNum := OpenResFile(theFile);
    err := ResError;
    IF (fRefNum = -1) AND (err = eofErr) THEN
      BEGIN
        CreateResFile(theFile);
        err := ResError;
        IF err = noErr THEN
          BEGIN
            fRefNum := OpenResFile(theFile);
            OpenAndMaybeCreateResFile := fRefNum;
          END;
      END;
    OpenAndMaybeCreateResFile := err;
  END;

  FUNCTION GetTypesToRead(paramPtr: XCMDPtr): ToGrab;  { look at parameter 2 -- }
{ If it's not there, we copy only XCMD's and XFCN's. }
{ If it's there, it's either "ALL", which means we copy all resources, }
{ or it tells us which resource type we should restrict our attention to. }
    VAR
      str: Str255;
  BEGIN
    GetTypesToRead := extensions;
    { default behavior is to grab just XCMD's and XFCN's }
    IF paramPtr^.paramCount > 1 THEN
  { if there is a second parameter, it tells us to behave otherwise }
      BEGIN
        ZeroToPas(paramPtr, paramPtr^.params[2]^, str);
        IF EqualString(str, 'ALL', FALSE, TRUE) THEN
          GetTypesToRead := all
  { if param 2 is "ALL", get all resource types }
        ELSE GetTypesToRead := userType;
      END;
  END;

  PROCEDURE GoHomeComeBack(paramPtr: XCMDPtr);
  { We go home and come back so that HyperCard will recognize
    the newly created resources.  If 'the name' is not HyperCard,
    i.e. if SuperCard is running, we don't do anything. }
    VAR
      hndl: Handle;
      str: Str255;
      shortString: String[5];
  BEGIN
    hndl := EvalExpr(paramPtr, 'the name');
    IF paramPtr^.result = noErr THEN
      BEGIN
      ZeroToPas(paramPtr, hndl^, str);
      DisposHandle(hndl);
      IF EqualString(str,'HyperCard',FALSE,TRUE) THEN
        BEGIN
        hndl := EvalExpr(paramPtr, 'the lockscreen');
        IF hndl <> NIL THEN
          BEGIN
          ZeroToPas(paramPtr, hndl^, str);
          shortString := str;
          DisposHandle(hndl);
          END
        ELSE shortString := 'FALSE';
        hndl := EvalExpr(paramPtr, 'the lockrecent');
        IF hndl <> NIL THEN
          BEGIN
          ZeroToPas(paramPtr, hndl^, str);
          DisposHandle(hndl);
          END
        ELSE str := 'FALSE';
        SendCardMessage(paramPtr, 'set lockscreen to true');
        SendCardMessage(paramPtr, 'set lockrecent to true');
        SendCardMessage(paramPtr, 'push card');
        SendCardMessage(paramPtr, 'go home');
        SendCardMessage(paramPtr, 'pop card');
        SendCardMessage(paramPtr, CONCAT('set lockscreen to ', shortString));
        SendCardMessage(paramPtr, CONCAT('set lockrecent to ', str));
        END;
      END;
  END;

  PROCEDURE GetResources (paramPtr : XCmdPtr);
    LABEL
      99;
    VAR
      err : OSErr;
      curFile, myStack, myFile : INTEGER;
      fileName : Str255;
      thisStack: Str255;
      whatToGet: ToGrab;
      alreadyOpen : BOOLEAN;
      paramCount : INTEGER;
      curs: CursHandle;
      h: Handle;

    PROCEDURE PassReturnValue (theMsg : Str255); { set theResult }
    BEGIN
      paramPtr^.returnValue := PasToZero(paramPtr, theMsg);
    END;

    PROCEDURE ReadAndCopyResources;
  { loop through resources, read, and copy }
      LABEL
        98;
      VAR
        index, i : INTEGER;
        resHandle, resAlready : Handle;
        theID : INTEGER;
        theCurrentType, theType : ResType;
        attrs: INTEGER;
        result: Handle;
        name: Str255;
        found: LONGINT;

    BEGIN  { loop through all resource types available in current res file }
      FOR i := 1 TO Count1Types DO
        BEGIN  { get the type we're looking at now }
        Get1IndType(theCurrentType, i);

        CASE whatToGet OF
          extensions:
            { unless we had a 2nd param, we'll copy only }
            { XCMD's and XFCN's }
            IF (theCurrentType <> 'XFCN')
              AND (theCurrentType <> 'XCMD') THEN
                Cycle;
{ if we did have a second param, then if it is "all" we'll }
{ copy everything.  Otherwise we copy only the types specified. }
          userType:
            BEGIN
            HLock(paramPtr^.params[2]);
            found := Munger(paramPtr^.params[2],0,@theCurrentType,4,NIL,0);
            HUnlock(paramPtr^.params[2]);
            IF found<0 THEN Cycle;
            END;
          all:
            { We don't copy resources of type CODE, FREF, or BNDL, }
            { because they can confuse the System, the Finder, }
            { or the Segment Loader when copied indiscriminately. }
            IF (theCurrentType = 'CODE')
              OR (theCurrentType = 'FREF')
              OR (theCurrentType = 'BNDL') THEN
                Cycle;
          END;

      { loop through all resources of this type }
        FOR index := 1 TO Count1Resources(theCurrentType) DO
          BEGIN  { get a resource of this type }
          SetResLoad(FALSE);
          resHandle := Get1IndResource(theCurrentType, index);
          GetResInfo(resHandle, theID, theType, name);
          err := ResError;
          IF (err <> noErr) OR (resHandle = NIL) THEN GOTO 98;

          ResrvMem(SizeResource(resHandle));
          err := MemError;
          IF err <> noErr THEN GOTO 98;

          SetResLoad(TRUE);
          LoadResource(resHandle);
          err := ResError;
          IF (err <> noErr) OR (resHandle = NIL) THEN GOTO 98;

          attrs := GetResAttrs(resHandle);
          DetachResource(resHandle);

          UseResFile(myStack);
          SetResLoad(FALSE);
          REPEAT
            resAlready := Get1Resource(theType, theID);
            IF resAlready <> NIL THEN
              BEGIN
                RmveResource(resAlready);
                DisposHandle(resAlready);
              END;
          UNTIL resAlready = NIL;
          REPEAT
            resAlready := Get1NamedResource(theType, name);
            IF resAlready <> NIL THEN
              BEGIN
                RmveResource(resAlready);
                DisposHandle(resAlready);
              END;
          UNTIL resAlready = NIL;
          SetResLoad(TRUE);

          AddResource(resHandle, theType, theID, name);
          { add the new resource }
          IF ResError <> noErr THEN
            BEGIN
            DisposHandle(resHandle);
            GOTO 98;
            END;

          SetResAttrs(resHandle, attrs);
          ChangedResource(resHandle);
          WriteResource(resHandle);
          UseResFile(myFile);
          { read from the source for the next resource of this type }

          98: SetResLoad(TRUE);
          END;  { for index := 1 to Count1Resources }
        END;  { for i := 1 to Count1Types }
      UpdateResFile(myStack);
    END;

  BEGIN  { procedure GetResources }
    err := noErr;
    curFile := CurResFile;
      { store the refNum of the current resource file }
    paramCount := paramPtr^.paramCount;
      { count the parameters we got }
    IF paramCount = 0 THEN
      BEGIN
      PassReturnValue('GetResources XCMD 1.6, 22 July 1989, ©1988-1989 Dartmouth College');
      GOTO 99;
      END;

    curs := GetCursor(watchCursor);
    SetCursor(curs^^);

    ZeroToPas(paramPtr, paramPtr^.params[1]^, fileName);

    err := MyOpenResFile(fileName, myFile, alreadyOpen);
    IF err <> noErr THEN GOTO 99;
    { continue only if MyOpenResFile worked OK }

    err := GetFullPathnameOfThisStack(paramPtr, thisStack);
    { get name of this stack }
    IF err <> noErr then GOTO 99;

    err := OpenAndMaybeCreateResFile(thisStack, myStack);
    { open resource fork of this stack }
    IF err <> noErr then GOTO 99;

    whatToGet := GetTypesToRead(paramPtr);
    UseResFile(myFile);
    ReadAndCopyResources;
    IF NOT alreadyOpen THEN CloseResFile(myFile);

    GoHomeComeBack(paramPtr);

    99: IF err <> noErr THEN
      BEGIN
      NumToStr(paramPtr, err, fileName);
      PassReturnValue(CONCAT('Error ', fileName));
      END;
    InitCursor;
    UseResFile(curFile);
    { restore the resource file that was current at the start of our code }
  END;

END.